VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000005&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "uTransfer"
   ClientHeight    =   6840
   ClientLeft      =   1740
   ClientTop       =   1935
   ClientWidth     =   7380
   ForeColor       =   &H00FFFFFF&
   Icon            =   "onebutton.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   Picture         =   "onebutton.frx":058A
   ScaleHeight     =   456
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   492
   Begin VB.CommandButton Command7 
      Caption         =   "About"
      Height          =   255
      Left            =   5760
      Style           =   1  'Graphical
      TabIndex        =   16
      Top             =   6120
      Width           =   855
   End
   Begin VB.CommandButton Command6 
      Caption         =   "Settings"
      Height          =   255
      Left            =   4800
      Style           =   1  'Graphical
      TabIndex        =   15
      Top             =   6120
      Width           =   855
   End
   Begin VB.Timer Timer2 
      Interval        =   1000
      Left            =   9240
      Top             =   3960
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   9120
      Top             =   3240
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton Command4 
      Height          =   605
      Left            =   4920
      Picture         =   "onebutton.frx":A790E
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   4680
      Width           =   1515
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Execuate"
      Height          =   375
      Left            =   8520
      TabIndex        =   8
      TabStop         =   0   'False
      Top             =   240
      Visible         =   0   'False
      Width           =   1095
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   8400
      Top             =   3240
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   ".txt"
      DialogTitle     =   "Save As"
      FileName        =   "REPORTRACK.TXT"
      Filter          =   "Text (*.txt) | *.txt"
      InitDir         =   "fGetSpecialFolder(5)"
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   6
      Top             =   6585
      Visible         =   0   'False
      Width           =   7380
      _ExtentX        =   13018
      _ExtentY        =   450
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.CheckBox Check2 
      BackColor       =   &H8000000E&
      Caption         =   "Auto Delete Data from Device After Transfer to PC"
      Height          =   200
      Left            =   480
      TabIndex        =   5
      Top             =   6120
      UseMaskColor    =   -1  'True
      Value           =   1  'Checked
      Width           =   200
   End
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   8640
      Top             =   3960
   End
   Begin VB.CheckBox Check1 
      BackColor       =   &H8000000E&
      Caption         =   "Sync Date and Time on Terminal with PC"
      Height          =   200
      Left            =   480
      MaskColor       =   &H00FFFFFF&
      Picture         =   "onebutton.frx":AAAA6
      TabIndex        =   4
      Top             =   5280
      UseMaskColor    =   -1  'True
      Value           =   1  'Checked
      Width           =   200
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      ItemData        =   "onebutton.frx":161C9A
      Left            =   8280
      List            =   "onebutton.frx":161CB6
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   2760
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.CommandButton Command5 
      Caption         =   "Upload Data"
      Height          =   440
      Left            =   8520
      TabIndex        =   1
      Top             =   840
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Purge Data"
      Height          =   440
      Left            =   8520
      TabIndex        =   0
      Top             =   2040
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "GetVersion"
      Height          =   375
      Left            =   8520
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   1440
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "Auto Delete Data from Device After Transfer to PC"
      Height          =   255
      Left            =   720
      TabIndex        =   14
      Top             =   6120
      Width           =   3975
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "Sync Date and Time on Terminal with PC"
      Height          =   255
      Left            =   720
      TabIndex        =   13
      Top             =   5280
      Width           =   3015
   End
   Begin VB.Label Label4 
      BackColor       =   &H80000009&
      BackStyle       =   0  'Transparent
      Caption         =   "Transfer Data From Your HT Device To Your Windows Desktop"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   480
      TabIndex        =   12
      Top             =   4080
      Width           =   6735
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "Connect HT580, HT630, or PT630 terminals to this PC and ensure you turn on all terminals before pressing the button."
      Height          =   855
      Left            =   480
      TabIndex        =   11
      Top             =   4440
      Width           =   3255
   End
   Begin VB.Label Label2 
      BackColor       =   &H8000000E&
      BackStyle       =   0  'Transparent
      Height          =   495
      Left            =   4680
      TabIndex        =   10
      Top             =   5520
      Width           =   2055
   End
   Begin VB.Label Label1 
      BackColor       =   &H8000000E&
      BackStyle       =   0  'Transparent
      Caption         =   "TIME"
      BeginProperty DataFormat 
         Type            =   0
         Format          =   "0"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   1033
         SubFormatType   =   0
      EndProperty
      Height          =   375
      Left            =   720
      TabIndex        =   3
      Top             =   5660
      Width           =   3135
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim CommData As Long
Dim currenttime As String
Dim Connect As Integer
' Connect = 0 ====> Not connected
' Connect = 1 ====> Connected
Dim Result As Integer
Dim Buffer As String
Dim TimeElapsed As Integer
Public diradd As String
Public filename As String
Public fileext As String
Public sync As String
Public del As String
Dim filecount() As Variant
Dim diraddT As String
Dim filenameT As String
Dim repeat As Integer
'Dim CommData As Long



Private Declare Function Online_ESC_Y_BYTE _
    Lib "C:\OnlineCommManager\OnlineDll.Dll" _
    Alias "Online_ESC_Y" _
    (ByVal CommData As Long, _
     ByVal tAdd As Integer, _
     ByRef bDat As Byte, _
     ByRef bLen As Byte) As Integer
     
Option Explicit

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As Long, _
    ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
    ByVal pszPath As String) As Long
    
Private Type EMID
    cb As Long
    abID As Byte
End Type

Private Type ITEMIDLIST
    mkid As EMID
End Type
Private Const MAX_PATH As Integer = 260

Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Const GENERIC_READ_WRITE As Long = &HC0000000
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_BEGIN As Long = 0
Private Const NO_ERROR As Long = 0
 
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _
     ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
     ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, _
     ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
     ByVal hTemplateFile As Long) As Long
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, _
     lpFileSizeHigh As Long) As Long
 
Private Declare Function SetFilePointer Lib "kernel32" ( _
     ByVal hFile As Long, ByVal lDistanceToMove As Long, _
     lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
 
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
 
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
     lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
     lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
 
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
     lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
     lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
 
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Sub DeleteData(ByVal filename As String, DeletePos As Long, DeleteLength As Long)
    Const cBuffSize As Long = 262144 ' 256 KBytes
    Dim SA As SECURITY_ATTRIBUTES
    Dim FHandle As Long
    Dim FileLen As Double
    Dim Buffer() As Byte, BuffPtr As Long
    Dim BytesToRead As Long, BytesRead As Long
    Dim ReadPos As Double, WritePos As Double
    ' using API position 0 is the first byte, using VB functions position 1 is first byte
    ' so decrement by one to use the same standard...
    DeletePos = DeletePos - 1
    ' open the file
    FHandle = CreateFile(filename, GENERIC_READ_WRITE, 0, SA, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    ' get file size
    FileLen = FileSizeDouble(FHandle)
    ' alocate memory
    ReDim Buffer(cBuffSize - 1)
    ' get memory pointer
    BuffPtr = VarPtr(Buffer(0))
    ' calculate read & write positions
    WritePos = DeletePos
    ReadPos = WritePos + DeleteLength
    ' shift the data to left
    Do Until ReadPos >= FileLen
        ' calculate how much data to read/write
        BytesToRead = dblMIN(cBuffSize, FileLen - ReadPos)
        ' copy and paste the data to the new location
        SeekPosDouble FHandle, ReadPos
        ReadFile FHandle, ByVal BuffPtr, BytesToRead, BytesRead, ByVal 0&
        SeekPosDouble FHandle, WritePos
        WriteFile FHandle, ByVal BuffPtr, BytesRead, BytesRead, ByVal 0&
        WritePos = WritePos + BytesRead
        ReadPos = WritePos + DeleteLength
    Loop
    If WritePos < FileLen Then
        ' Seek to where we need to truncate the file
        SeekPosDouble FHandle, WritePos
        ' truncate the file
        SetEndOfFile FHandle
    End If
    Erase Buffer
    If FHandle <> 0 Then CloseHandle FHandle
End Sub
 
Private Function dblMIN(ByVal V1 As Double, ByVal V2 As Double) As Double
    If V1 < V2 Then
        dblMIN = V1
    Else
        dblMIN = V2
    End If
End Function
 
Private Function SeekPosDouble(ByVal FHandle As Long, ByVal NewPos As Double) As Boolean
    Dim SizeLow As Long, SizeHigh As Long
    SizeLow = DoubleToLongs(NewPos, SizeHigh)
    SeekPosDouble = SeekPos(FHandle, SizeLow, SizeHigh)
End Function
 
 Private Function SeekPos(ByVal FHandle As Long, ByVal NewPos As Long, _
                                   Optional ByVal PosHigh As Long = 0) As Boolean
    Dim Ret As Long, dwError As Long
    Ret = SetFilePointer(FHandle, NewPos, PosHigh, FILE_BEGIN)
    If Ret = -1 Then
        dwError = GetLastError
        If dwError = NO_ERROR Then SeekPos = True
    Else
        SeekPos = True
    End If
End Function
 
Private Function FileSizeDouble(ByVal FHandle As Long) As Double
    Dim SizeLow As Long, SizeHigh As Long
    If FHandle <> 0 Then SizeLow = GetFileSize(FHandle, SizeHigh)
    FileSizeDouble = CDbl(SizeHigh) * (2 ^ 32) + LongToDouble(SizeLow)
End Function
 
Private Function LongToDouble(ByVal Lng As Long) As Double
    If Lng And &H80000000 = 0 Then
        LongToDouble = CDbl(Lng)
    Else
        LongToDouble = (Lng Xor &H80000000) + (2 ^ 31)
    End If
End Function
 
Private Function DoubleToLongs(ByVal Dbl As Double, ByRef SizeHigh As Long) As Long
    Dim SizeLowDbl As Double
    SizeHigh = Fix(Dbl / 4294967296#)
    SizeLowDbl = Dbl - SizeHigh * 4294967296#
    If SizeLowDbl > 2147483647 Then
        DoubleToLongs = CLng(SizeLowDbl - 2147483648#) Xor &H80000000
    Else
        DoubleToLongs = SizeLowDbl
    End If
End Function

Function SaveAsCommonDialog(Optional sTitle = "Save File", Optional sFilter As String, Optional sDefaultDir As String) As String
    Const clBufferLen As Long = 255
    Dim OFName As OPENFILENAME, sBuffer As String * clBufferLen

    
    On Error GoTo ExitFunction
    OFName.lStructSize = Len(OFName)
    OFName.hWndOwner = GetActiveWindow  'or Me.hwnd in VB
    OFName.hInstance = 0                'or App.hInstance in VB
    If Len(sFilter) Then
        OFName.lpstrFilter = sFilter
    Else
        OFName.lpstrFilter = "Text Files (*.txt)" & Chr$(0) & "*.txt" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*" & Chr$(0)
    End If
    OFName.lpstrFile = sBuffer
    OFName.nMaxFile = clBufferLen       'Set max number of characters
    OFName.lpstrFileTitle = sBuffer
    OFName.nMaxFileTitle = clBufferLen  'Set max number of characters
    'Set the initial directory
    If Len(sDefaultDir) Then
        OFName.lpstrInitialDir = sDefaultDir
    Else
        OFName.lpstrInitialDir = CurDir$
    End If
    OFName.lpstrTitle = sTitle
    OFName.Flags = 0

    'Show dialog
    If GetSaveFileNameA(OFName) Then
        If (Right(Left$(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) - 1), 4) = Right(OFName.lpstrFilter, 4)) Then
            SaveAsCommonDialog = Left$(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) - 1)
        Else
            SaveAsCommonDialog = Left$(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) - 1) & Right(OFName.lpstrFilter, 4)
        End If
'                SaveAsCommonDialog = Left$(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) - 1)
    Else
        SaveAsCommonDialog = "TRACK.TXT"
    End If
ExitFunction:
    On Error GoTo 0
End Function

Private Sub Check1_Click()
    Open "settings.ini" For Output As #2
    If Check1.Value = 0 Then
        Print #2, "0"
    Else
        Print #2, "1"
    End If
    Print #2, del
    Print #2, diradd
    Print #2, filename
    Print #2, fileext
    Close #2
End Sub

Private Sub Check2_Click()
    Open "settings.ini" For Output As #2
    Print #2, sync
    If Check2.Value = 0 Then
        Print #2, "0"
    Else
        Print #2, "1"
    End If
    Print #2, diradd
    Print #2, filename
    Print #2, fileext
    Close #2
End Sub

'get the version of the unit
Private Sub Command1_Click()
Call CheckPort(6)
Dim x As Integer
x = 1
While (x < 22)
    If (CheckPort(x) = 0) Then
        'MsgBox ("good " & x)
    End If
x = x + 1
Wend

   'Dim CommData As Long
   'Dim Result As Integer
   'Dim sSize As Long
   'Dim lSize As Long
   'Dim Port As Integer
   'Dim version As String
   'version = "aaaaa"
   
   
   'Port = Combo1.ListIndex + 1
   'If Check1.Value = 1 Then
   '  Call SetDate
   'End If

   'CommData = Online_Create()
   'If CommData <> 0 Then
   '    Result = Online_SetupEx(CommData, Port, _
                    Asc("9"), Asc("1"), Asc("N"))
       'Suppose Result = 1
   '    Result = Online_Connect(CommData)
       'Suppose Result = 1
   'Call Online_GetVersion(CommData, Asc("A"), version, 15)
   'MsgBox ("Verison = " & version)
   'Call Online_ESC_R(CommData, Asc("A"), version, 15)
   'MsgBox ("Verison = " & version)
   'Call Online_Disconnect(CommData)
   'Call Online_Destroy(CommData)
   'End If
End Sub


'run the EZJB.EJS job on the HT580
Private Sub Command2_Click()
'   Dim CommData As Long
   Dim Result As Integer
   Dim sSize As Long
   Dim lSize As Long
   Dim Port As Integer
   Port = Combo1.ListIndex + 1
   If Check1.Value = 1 Then
     Call SetDate
   End If
      
   CommData = Online_Create()
   If CommData <> 0 Then
       Result = Online_SetupEx(CommData, Port, _
                    Asc("9"), Asc("1"), Asc("N"))
       'Suppose Result = 1
       Result = Online_Connect(CommData)
       'Suppose Result = 1
   Result = Online_ESC_X(CommData, Asc("A"), "EZJB.EJS", 8)
   MsgBox (Result)
   Call Online_Disconnect(CommData)
   Call Online_Destroy(CommData)
   End If
End Sub

Private Sub Command5_Click() 'upload the data
'   Dim CommData As Long
   Dim Result As Integer
   Dim Result2 As String
   Dim sSize As Long
   Dim lSize As Long
   Dim bLen As Byte
   Dim Msg As String
   Dim Port As Integer
   Port = Combo1.ListIndex + 1
   
   If Check1.Value = 1 Then
   Call SetDate
   End If
   
   Dim sFilePath As String
   
'   sFilePath = SaveAsCommonDialog("Save As", "*.txt", "%userprofile%\My Documents\")
   
'   If sFilePath = "TRACK.TXT" Then
'      GoTo outofhere
'    End If
    
   
'   While sFilePath = "TRACK.TXT"
'     sFilePath = SaveAsCommonDialog("Save As", "*.txt", "%userprofile%\My Documents\")
'   Wend
    CommonDialog1.Flags = cdlOFNOverwritePrompt
    CommonDialog1.InitDir = fGetSpecialFolder(5)
    CommonDialog1.filename = "REPORTRACK.TXT"
    CommonDialog1.ShowSave
    sFilePath = CommonDialog1.filename
'    MsgBox sFilePath
    If sFilePath = "REPORTRACK.TXT" Then
    GoTo outofhere
    End If
    If Dir(sFilePath) <> "" Then
    Kill sFilePath
    End If
    
    'MsgBox Msg
    
    

   
   bLen = 9
   Msg = "TRACK.TXT"
   CommData = Online_Create()
   If CommData <> 0 Then
       Result = Online_SetupEx(CommData, Port, _
                    Asc("8"), Asc("1"), Asc("N"))
       'Suppose Result = 1
       Result = Online_Connect(CommData)
       Result = Online_ESC_J(CommData, Asc("A"), Msg, bLen)
'       MsgBox Result
       If Result <> 8 And Result <> 6 Then
'       MsgBox "File does not exist or Machine is not powered on"
       Call Online_Disconnect(CommData)
       Call Online_Destroy(CommData)
       GoTo outofhere
       End If
       
       Msg = Left(Msg, 6)
  '     MsgBox (Msg)
  '     bLen = Int(Msg)
  '     MsgBox Int(Msg)
       bLen = Int(Msg) / 100
       If bLen < 100 Then
       bLen = 100
       End If
       
       
   ProgressBar1.Min = 0
   ProgressBar1.Max = bLen
 '  ProgressBar1.Max = 100
   ProgressBar1.Value = 0
   
   
       'Suppose Result = 1
       Result = Online_UpLoad(CommData, Asc("A"), _
                   sFilePath, _
                   "TRACK.TXT", _
                    0, 3)
ProgressBar1.Value = 1

       If Result > 0 Then
       Do
       Result = Online_StLoad(CommData, 0, sSize, lSize)
ProgressBar1.Value = ProgressBar1.Value + 1
       Loop Until Result >= 2
       End If
        
       If Result = 0 Then
       MsgBox "File does not exist or Machine is not turned on"
       Call Online_Disconnect(CommData)
       Call Online_Destroy(CommData)
       GoTo outofhere
       End If
ProgressBar1.Value = ProgressBar1.Value + 1
       Result = Online_StLoad(CommData, 1, sSize, lSize)
       ' To make sure that transfer finished
'ProgressBar1.Value = ProgressBar1.Value + 1
       Create_ShortCut sFilePath, "Desktop", "REPORTRACK.TXT", , 0, 0
       
       Dim iFile As Integer
Dim lByteLen As Long
Dim bytData As Byte
Dim bytArray() As Byte
Dim sHex As String
'get an available file ID
iFile = FreeFile
'open the file for access
Open sFilePath For Binary As iFile
'get current len of file
lByteLen = LOF(iFile)
'MsgBox lByteLen
Dim i As Integer
Dim N As Integer
N = 23
i = 0
'While I < lByteLen
    bytData = 127
'    Put iFile, N, bytData
'N = N + 31
'I = N
'Wend
Close iFile
Dim x As Long
Dim Y As Long
x = 1
Y = 23
While Y < lByteLen
    DeleteData sFilePath, Y, 1
    Y = Y + 31
Wend

'editing data file (remove comma between date and time)


ProgressBar1.Value = ProgressBar1.Max
       MsgBox "Upload Complete"
       
       If Check2.Value = 1 Then
          Call Online_ESC_E(CommData, Asc("A"), "TRACK.TXT", 9) '||'
          MsgBox "Purge Complete"
       End If
       
       'MsgBox "Shortcut Created on Desktop"
       Call Online_Disconnect(CommData)
       Call Online_Destroy(CommData)
       
    End If
outofhere:

       ProgressBar1.Value = 0
End Sub

Private Sub Command4_Click() 'download the FORM.DAT with one click
'   Dim CommData As Long
   Dim Result As Integer
   Dim sSize As Long
   Dim lSize As Long
   Dim version As String
   Dim bLen As Byte
   Dim Msg As String
   Dim sFilePath As String
   Dim Port As Integer '1 to 20
   version = "00000"
   Port = 0
   Dim filecounter As String
   filecounter = 0

   Label2.Caption = "Searching..."
   bLen = 8
   Msg = "FORM.DAT"

    Dim temp As String, i As Long
    Dim Lister As New DevLister, PortGUID() As GUID_Storage

    'ControlsEn False
    temp = Lister.GetGUIDByName("Ports", PortGUID)
    If temp = "OK" Then
        temp = Lister.AddToList(PortGUID(0))
        If temp = "OK" Then
            repeat = 1
REP:
            temp = ""
            For i = 1 To Lister.ListCount
                temp = temp & Lister.Item(i).GetName & vbCrLf
                If (Left$(Lister.Item(i).GetName, 15) = "USB Serial Port" Or Left$(Lister.Item(i).GetName, 19) = "Communications Port") Then
                    If (Mid$(Lister.Item(i).GetName, 17, 1) = "(" And Mid$(Lister.Item(i).GetName, 22, 1) = ")") Then
                        Port = Val(Mid$(Lister.Item(i).GetName, 21, 1))
                    End If
                        'MsgBox (Mid$(Lister.Item(i).GetName, 22, 1))
                    If (Mid$(Lister.Item(i).GetName, 17, 1) = "(" And Mid$(Lister.Item(i).GetName, 23, 1) = ")") Then
                        Port = Val(Mid$(Lister.Item(i).GetName, 21, 2))
                        'MsgBox (Mid$(Lister.Item(i).GetName, 22, 1))
                    End If
                    If (Mid$(Lister.Item(i).GetName, 21, 1) = "(" And Mid$(Lister.Item(i).GetName, 26, 1) = ")") Then
                        Port = Val(Mid$(Lister.Item(i).GetName, 25, 1))
                        'MsgBox (Mid$(Lister.Item(i).GetName, 22, 1))
                    End If
                    If (Mid$(Lister.Item(i).GetName, 21, 1) = "(" And Mid$(Lister.Item(i).GetName, 27, 1) = ")") Then
                        Port = Val(Mid$(Lister.Item(i).GetName, 25, 2))
                        'MsgBox (Mid$(Lister.Item(i).GetName, 22, 1))
                    End If
                    'MsgBox (Mid$(Lister.Item(i).GetName, 21, 2))
                    'MsgBox ("found port: " & Port)
                    
                    'DoEvents
                    'If CheckPort(Port) = 1 Then GoTo outofhere
                        Timer2.Enabled = True
                        If TimeElapsed > 10 Then
                            DoEvents
                            GoTo outofhere
                        End If
                        
                    'MsgBox ("if" & Port)
                    CommData = Online_Create()
                    If CommData <> 0 Then
                        Result = Online_SetupEx(CommData, Port, Asc("8"), Asc("1"), Asc("N"))
                        Result = Online_Connect(CommData)
                        If Result = 1 Then
                            'MsgBox ("connected")
                            GoTo connected
                        Else
                            Call Online_Disconnect(CommData)
                            Call Online_Destroy(CommData)
                            CommData = Online_Create()
                            Result = Online_SetupEx(CommData, Port, Asc("9"), Asc("1"), Asc("N"))
                            Result = Online_Connect(CommData)
                            If Result = 1 Then
                                'MsgBox ("connected")
                                GoTo connected
                            Else
                        Call Online_Disconnect(CommData)
                        Call Online_Destroy(CommData)
                                GoTo outofhere
                            End If
connected:
                        'MsgBox ("check file start")
                        bLen = 8
                        Msg = "FORM.DAT"
                        Result = Online_ESC_J(CommData, Asc("A"), Msg, bLen)

                        If Result <> 8 And Result <> 6 Then
                            Call Online_Disconnect(CommData)
                            Call Online_Destroy(CommData)
                            CommData = Online_Create()
                            Result = Online_SetupEx(CommData, Port, Asc("9"), Asc("1"), Asc("N"))
                            Result = Online_Connect(CommData)
                            If Check1.Value = 1 Then
                                Call Online_ESC_M(CommData, Asc("A"), currenttime)
                            End If
                            bLen = 8
                            Msg = "FORM.DAT"
                            Result = Online_ESC_J(CommData, Asc("A"), Msg, bLen)
                            'MsgBox (Result)
                            If Result <> 8 And Result <> 6 Then
                                'MsgBox "File does not exist or Machine is not powered on"
                                Call Online_Disconnect(CommData)
                                Call Online_Destroy(CommData)
                                'MsgBox ("check file failed")
                                GoTo outofhere
                            End If
                        End If
                        'MsgBox ("check file successful")
                        'sFilePath = fGetSpecialFolder(16) & "\" & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & ".csv"
                        If diradd = "My Docunments" Then
                            diraddT = fGetSpecialFolder(5)
                        ElseIf diradd = "Desktop" Then
                            diraddT = fGetSpecialFolder(16)
                        Else
                            diraddT = diradd
                        End If
                        'MsgBox (diradd & " " & diraddT)
                        If filename = "%T" Then
                            filenameT = SetDate
                        Else
                            filenameT = filename
                        End If
                        If Right(diraddT, 1) = "\" Then
                            sFilePath = diraddT & filenameT & filecount(filecounter) & "." & fileext
                        Else
                            sFilePath = diraddT & "\" & filenameT & filecount(filecounter) & "." & fileext
                        End If
                        If Dir(sFilePath) <> "" Then
                            Kill sFilePath
                        End If
                        'MsgBox (sFilePath)
                        'MsgBox ("polling file start")
                        Label2.Caption = "Downloading FORM.DAT from COM" & Port
                        Result = Online_UpLoad(CommData, Asc("A"), sFilePath, "FORM.DAT", 0, 3)
                        If Result > 0 Then
                        Do
                            Result = Online_StLoad(CommData, 0, sSize, lSize)
                            TimeElapsed = 0
                            Timer2.Enabled = True
                            DoEvents
                            If TimeElapsed > 10 Then
                                Result = 10
                            End If
                        Loop Until Result >= 2
                        End If
                        If Result = 0 Then
                            'MsgBox "File does not exist or Machine is not turned on"
                            Call Online_Disconnect(CommData)
                            Call Online_Destroy(CommData)

                            'MsgBox ("polling file failed")

                            GoTo outofhere
                        Else

                        'MsgBox ("polling file successful")

                            filecounter = filecounter + 1
                            repeat = 0
                        End If
                        Result = Online_StLoad(CommData, 1, sSize, lSize)
                        If Check2.Value = 1 Then
                            Call Online_ESC_E(CommData, Asc("A"), "FORM.DAT", 8)
                            'MsgBox "Purge Complete"
                        End If

                        If Check1.Value = 1 Then
'                        MsgBox ("set time start")
                            Call SetDate
                            Call Online_ESC_M(CommData, Asc("A"), currenttime)
'                        MsgBox ("set time end")
                        End If

                        Call Online_Disconnect(CommData)
                        Call Online_Destroy(CommData)
outofhere:
                    End If

                'End If
                End If
'                 MsgBox (Port & "end")
'
'
'
                End If
                        TimeElapsed = 0
            Next i
        Else
            'MsgBox temp, vbCritical, "Error Getting Device List"
        End If
        If repeat = 1 Then
            repeat = 0
            GoTo REP
        End If
    Else
        'MsgBox temp, vbCritical, "Error Finding 'Ports' GUID"
    End If
    'MsgBox temp
    

   

Label2.Caption = "Finished download " & filecounter & " file(s) at " & Now



End Sub

Private Sub Command6_Click()
    Settings.Show
End Sub

Private Sub Command7_Click()
'    Dim temp As String, i As Long
'    Dim tempcom As Integer
'    Dim Lister As New DevLister, PortGUID() As GUID_Storage
'    'ControlsEn False
'    temp = Lister.GetGUIDByName("Ports", PortGUID)
'    If temp = "OK" Then
'        temp = Lister.AddToList(PortGUID(0))
'        If temp = "OK" Then
'            temp = ""
'            For i = 1 To Lister.ListCount
'                temp = temp & Lister.Item(i).GetName & vbCrLf
'                If (Left$(Lister.Item(i).GetName, 15) = "USB Serial Port") Then
'                If (Mid$(Lister.Item(i).GetName, 22, 1) = ")") Then
'                    tempcom = Val(Mid$(Lister.Item(i).GetName, 21, 1))
'                    'MsgBox (Mid$(Lister.Item(i).GetName, 22, 1))
'                Else
'                    tempcom = Val(Mid$(Lister.Item(i).GetName, 21, 2))
'                    'MsgBox (Mid$(Lister.Item(i).GetName, 22, 1))
'                End If
'
'                'MsgBox (Mid$(Lister.Item(i).GetName, 21, 2))
'                    MsgBox ("found one:" & tempcom)
'                End If
'            Next i
'        Else
'            'MsgBox temp, vbCritical, "Error Getting Device List"
'        End If
'    Else
'        'MsgBox temp, vbCritical, "Error Finding 'Ports' GUID"
'    End If
'    MsgBox temp
    'ControlsEn True
'Dim abcde As String
'abcde = "               "
'CommData = Online_Create()
'            Result = Online_SetupEx(CommData, 3, Asc("8"), Asc("1"), Asc("N"))
'            Result = Online_Connect(CommData)
'MsgBox Online_ESC_T(CommData, Asc("A"), abcde, 15, 0)
'                Call Online_Disconnect(CommData)
'                Call Online_Destroy(CommData)
'MsgBox (abcde)
    frmAbout.Show
End Sub


Private Sub Form_Load()
    
    filecount() = Array("", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19")

    Timer1.Enabled = True
    Combo1.ListIndex = 0
    ProgressBar1.Value = 0
    Call SetDate
    Label1.Caption = Left(WeekdayName(Weekday(Now)), 3) & ", " & Now
    
    If Dir("settings.ini") <> "" Then

    Else
        Open "settings.ini" For Output As #2
        Print #2, "1"
        Print #2, "0"
        Print #2, "Desktop"
        Print #2, "FORM"
        Print #2, "DAT"
        Close #2
    End If
    
    Open "settings.ini" For Input As #1
    Input #1, sync
    Input #1, del
    Input #1, diradd
    Input #1, filename
    Input #1, fileext
    Close #1
    If sync = "1" Then
        Check1.Value = 1
    Else
        Check1.Value = 0
    End If
    If del = "1" Then
        Check2.Value = 1
    Else
        Check2.Value = 0
    End If
    
    'If diradd = "My Docunments" Then
    '   diradd = fGetSpecialFolder(5)
    'ElseIf diradd = "Desktop" Then
    '    diradd = fGetSpecialFolder(16)
    'End If
        
   
End Sub
   
   Private Sub Form_Unload(Cancel As Integer)
   If CommData <> 0 Then
   'Call Online_Destroy(CommData)
   CommData = 0
   Connect = 0
   End If
   Settings.cmdCancel = True
   frmAbout.cmdOK_Click
   'Form1.Hide
   
   End Sub


   
   Private Sub Command3_Click() 'Delete the data in the device
'   Dim CommData As Long
   Dim Result As Integer
   Dim sSize As Long
   Dim lSize As Long
   Dim Port As Integer
   Port = Combo1.ListIndex + 1
   If Check1.Value = 1 Then
     Call SetDate
   End If
      
   CommData = Online_Create()
   If CommData <> 0 Then
       Result = Online_SetupEx(CommData, Port, _
                    Asc("9"), Asc("1"), Asc("N"))
       'Suppose Result = 1
       Result = Online_Connect(CommData)
       'Suppose Result = 1
   Call Online_ESC_E(CommData, Asc("A"), "TRACK.TXT", 9)
   MsgBox "Purge Complete"
   Call Online_Disconnect(CommData)
   Call Online_Destroy(CommData)
   End If
   End Sub


Public Function SetDate() As String
   'Set Date & Time
'   Dim CommData As Long
   Dim Result As Integer
   Dim sSize As Long
   Dim lSize As Long
   
   Dim Port As Integer
   Port = Combo1.ListIndex + 1
   
   Dim clock As String
   Dim xYear As String
   Dim xMonth As String
   Dim xDay As String
   Dim xHour As String
   Dim xMinute As String
   Dim xSecond As String
   'xYear = DatePart("yyyy", Now)
   'xMonth = DatePart("m", Now)
   'xDay = DatePart("d", Now)
   xYear = Year(Now)
   xMonth = Month(Now)
   xDay = Day(Now)
   'xHour = DatePart("h", Now)
   xHour = Hour(Now)
   'xMinute = DatePart("m", Now)
   xMinute = Minute(Now)
   'xSecond = DatePart("s", Now)
   xSecond = Second(Now)
   If (xMonth = "1" Or xMonth = "2" Or xMonth = "3" Or xMonth = "4" Or xMonth = "5" Or xMonth = "6" Or xMonth = "7" Or xMonth = "8" Or xMonth = "9") Then
   xMonth = "0" & xMonth
   End If
   If (xDay = "1" Or xDay = "2" Or xDay = "3" Or xDay = "4" Or xDay = "5" Or xDay = "6" Or xDay = "7" Or xDay = "8" Or xDay = "9") Then
   xDay = "0" & xDay
   End If
   If (xHour = "0" Or xHour = "1" Or xHour = "2" Or xHour = "3" Or xHour = "4" Or xHour = "5" Or xHour = "6" Or xHour = "7" Or xHour = "8" Or xHour = "9") Then
   xHour = "0" & xHour
   End If
   If (xMinute = "0" Or xMinute = "1" Or xMinute = "2" Or xMinute = "3" Or xMinute = "4" Or xMinute = "5" Or xMinute = "6" Or xMinute = "7" Or xMinute = "8" Or xMinute = "9") Then
   xMinute = "0" & xMinute
   End If
   If (xSecond = "0" Or xSecond = "1" Or xSecond = "2" Or xSecond = "3" Or xSecond = "4" Or xSecond = "5" Or xSecond = "6" Or xSecond = "7" Or xSecond = "8" Or xSecond = "9") Then
   xSecond = "0" & xSecond
   End If
   
   clock = xYear & xMonth & xDay & xHour & xMinute & xSecond
   'MsgBox clock
   'MsgBox Now
   currenttime = clock
   SetDate = clock
End Function

Private Sub Timer1_Timer()

   Label1.Caption = Left(WeekdayName(Weekday(Now)), 3) & ", " & Now

End Sub
    
    

Sub Create_ShortCut(ByVal TargetPath As String, ByVal ShortCutPath As String, ByVal ShortCutname As String, Optional ByVal WorkPath As String, Optional ByVal Window_Style As Integer, Optional ByVal IconNum As Integer)

Dim VbsObj As Object
Set VbsObj = CreateObject("WScript.Shell")
Dim MyShortcut As Object
ShortCutPath = VbsObj.SpecialFolders(ShortCutPath)
Set MyShortcut = VbsObj.CreateShortcut(ShortCutPath & "\" & ShortCutname & ".lnk")
MyShortcut.TargetPath = TargetPath
MyShortcut.WorkingDirectory = WorkPath
MyShortcut.WindowStyle = Window_Style
MyShortcut.IconLocation = TargetPath & "," & IconNum
MyShortcut.Save

End Sub




Public Function fGetSpecialFolder(ByVal CSIDL As Long) As String
    'This function will find My documents path.
    'value       Result
    '2           C:\Documents and Settings\<USERNAME>\Start Menu\Programs
    '5           C:\Documents and Settings\<USERNAME>\My Documents
    '6           C:\Documents and Settings\<USERNAME>\Favorites
    '7           C:\Documents and Settings\<USERNAME>\Start Menu\Programs\Startup
    '8           C:\Documents and Settings\<USERNAME>\Recent
    '9           C:\Documents and Settings\<USERNAME>\SendTo
    '11          C:\Documents and Settings\<USERNAME>\Start Menu
    '13          C:\Documents and Settings\scsrinivasan\My Documents\My Music
    '16          C:\Documents and Settings\<USERNAME>\Desktop
    '19          C:\Documents and Settings\<USERNAME>\NetHood
    '20          C:\WINNT\Fonts
    '21          C:\Documents and Settings\<USERNAME>\Templates
    '22          C:\Documents and Settings\All Users\Start Menu
    '23          C:\Documents and Settings\All Users\Start Menu\Programs
    '24          C:\Documents and Settings\All Users\Start Menu\Programs\Startup
    '25          C:\Documents and Settings\All Users\Desktop
    '26          C:\Documents and Settings\<USERNAME>\Application Data
    '27          C:\Documents and Settings\<USERNAME>\PrintHood
    '28          C:\Documents and Settings\<USERNAME>\Local Settings\Application Data
    '31          C:\Documents and Settings\All Users\Favorites
    '32          C:\Documents and Settings\<USERNAME>\Local Settings\Temporary Internet Files
    '33          C:\Documents and Settings\<USERNAME>\Cookies
    '34          C:\Documents and Settings\<USERNAME>\Local Settings\History
    '35          C:\Documents and Settings\All Users\Application Data
    '36          C:\WINNT37          C:\WINNT\system32
    '38          C:\Program Files
    '39          C:\Data\My Pictures
    '40          C:\Documents and Settings\<USERNAME>
    '41          C:\WINNT\system32
    '43          C:\Program Files\Common Files
    '45          C:\Documents and Settings\All Users\Templates
    '46          C:\Documents and Settings\All Users\Documents
    '47          C:\Documents and Settings\All Users\Start Menu\Programs\Administrative Tools
    '48          C:\Documents and Settings\<USERNAME>\Start Menu\Programs\Administrative Tools
    Dim sPath As String
    Dim IDL As ITEMIDLIST

    On Error GoTo fGetSpecialFolder_Error

    fGetSpecialFolder = ""
    If SHGetSpecialFolderLocation(0, CSIDL, IDL) = 0 Then
        sPath = Space$(MAX_PATH)
        If SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) Then
            fGetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1) & ""
        End If
    End If

    On Error GoTo 0
    Exit Function

fGetSpecialFolder_Error:
    Err.Clear
    Resume Next
End Function


Private Function CheckPort(x As Integer) As Integer
    CheckPort = 1
    Timer2.Enabled = False
    
        'If x <> 1 Then MsgBox ("---------------------" & x)
   
    MsgBox "Checking COM" & Trim(Str(x)) & "..."
   
    'Check for port status

        If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
   
    'Start error handling
    On Error GoTo ErrorHandler
    MSComm1.CommPort = x
    MSComm1.Settings = "19200,N,8,1"
    MSComm1.InputLen = 0
    MSComm1.PortOpen = True
    On Error GoTo 0
   
MsgBox (MSComm1)

    MSComm1.Output = "ATI1" & Chr$(13)
        
    'Wait for a response for 2 seconds. If nothing returns then exit
    MsgBox ("N1")

        If WaitForResponse(1) = False Then GoTo NothingReturned
        
    MSComm1.Output = "ATI4" & Chr$(13)
    MsgBox ("N2")
    'Wait for response for 2 seconds. If nothing returns then exit

        If WaitForResponse(1) = False Then GoTo NothingReturned
    
    'If something returned...
    'MsgBox ParseBuffer(buffer)
    'MsgBox "COM" & Trim(Str(X)) & " is a modem."
    MSComm1.PortOpen = False
    'COMicon(X - 1).Picture = LoadResPicture(102, vbResIcon)
    'COMicon(X - 1).Caption = "COM " + Str(X)
    'COMicon(X - 1).Visible = True
    'PortType(X - 1).Caption = "Modem"
    'PortInfo(X - 1) = ParseBuffer(Buffer)
    'PortType(X - 1).Visible = True
    'PortSettings(X - 1).Caption = UCase(MSComm1.Settings)
    'PortSettings(X - 1).Visible = True
    'COMiconTip(X - 1).Title = "Modem"
    'COMiconTip(X - 1).TipText = "COM" & Str(X) & " Installed" & vbCrLf & PortInfo(X - 1) & vbCrLf & "Click for Details"
    CheckPort = 1
    Exit Function
   
NothingReturned:
    MsgBox "Is an installed COM Port"
    MSComm1.PortOpen = False
    CheckPort = 0
    'COMicon(X - 1).Picture = LoadResPicture(101, vbResIcon)
    'COMicon(X - 1).Caption = "COM" + Str(X)
    'COMicon(X - 1).Visible = True
    'PortType(X - 1).Caption = "Serial Port"
    'PortInfo(X - 1) = ""
    'PortType(X - 1).Visible = True
    'PortSettings(X - 1).Caption = UCase(MSComm1.Settings)
    'PortSettings(X - 1).Visible = True
    'COMiconTip(X - 1).Title = "Serial Port"
    'COMiconTip(X - 1).TipText = "COM" & Str(X) & " Installed" & vbCrLf & "Click for Details"
    
    Exit Function


ErrorHandler:

    MsgBox Err.Number
    CheckPort = Err.Number
    'MsgBox ErrorString(Err.Number, X)

End Function


Private Function WaitForResponse(x As Integer) As Boolean
On Error GoTo Handler:
    Buffer = ""
    WaitForResponse = False
    TimeElapsed = 0
    Timer2.Enabled = True
    Do
        DoEvents
        Buffer = Buffer & MSComm1.Input
            If Len(Buffer) <> 0 Then
                If InStr(1, Buffer, "OK") <> 0 Then
                    WaitForResponse = True
                    Timer2.Enabled = False
                    TimeElapsed = 0
                    Exit Function
                End If
            End If
            If TimeElapsed > x Then
                Timer2.Enabled = False
                Exit Function
            End If
    Loop
Handler:

End Function

Private Function WaitX(x As Integer) As Boolean
On Error GoTo Handler:
    Buffer = ""
    WaitX = False
    TimeElapsed = 0
    Timer2.Enabled = True
    'Call Online_ESC_M(CommData, Asc("A"), currenttime)
    Dim version As String
    version = "*****"
    Dim bLen As Integer
    Do
        DoEvents
            Call Online_ESC_R(CommData, Asc("A"), version, 5)
            'MsgBox (version)
                'If version = "HT630" Or version = "HT580" Then
                    WaitX = True
                    Timer2.Enabled = False
                    TimeElapsed = 0
                    'MsgBox ("true")
                    Exit Function
                'End If
            If TimeElapsed > x Then
                Timer2.Enabled = False
                'MsgBox ("false")
                Exit Function
            End If
    Loop
Handler:

End Function

Private Sub Timer2_Timer()
    TimeElapsed = TimeElapsed + 1
End Sub

Private Function ParseBuffer(x As String) As String
    Dim i As Integer
    Dim Splitter As String
    Dim Pos1, Pos2 As Integer
    Splitter = Chr(13) & Chr(10)
    Pos1 = InStr(1, x, Splitter)
    Pos2 = InStr(Pos1 + 2, x, Splitter)
    ParseBuffer = Mid(x, Pos1 + 2, Pos2 - Pos1 - 2)
End Function
